#!/usr/bin/perl
#??? make the www. prefix optional for the League Website field
# chop it when sending it to the cgi-bin program 'published'.
# when loading the contacts from the uploaded file
# chop off the www. prefix (http:// too).
use strict;
use warnings;

# the following are not really comments
# they're more like perl2exe controls.

#perl2exe_exclude "File/BSDGlob.pm"
#perl2exe_exclude "Compress/Bzip2.pm"
#perl2exe_exclude "I18N/Langinfo.pm"
#perl2exe_exclude "Convert/EBCDIC.pm"
#perl2exe_exclude "Mac/InternetConfig.pm"
#perl2exe_exclude "MacPerl.pm"
#perl2exe_exclude "Encode/ConfigLocal.pm"

#perl2exe_include "File/Glob.pm"
#perl2exe_include "feature.pm"
#perl2exe_include "attributes.pm"
#perl2exe_include "Class/Accessor.pm"
#perl2exe_include "File::HomeDir::Windows.pm"
#perl2exe_include utf8;
#perl2exe_include "unicore/lib/gc_sc/Word.pl"
#perl2exe_include "unicore/lib/gc_sc/Digit.pl"
#perl2exe_include "unicore/lib/gc_sc/SpacePer.pl"
#perl2exe_include "unicore/To/Fold.pl"
#perl2exe_include "unicore/To/Upper.pl"
#perl2exe_include "unicore/To/Lower.pl"
#perl2exe_include "unicore/lib/gc_sc/Alpha.pl"
#perl2exe_include "Tk/Scrollbar.pm"
#perl2exe_include "Tk/Canvas.pm"

my $table_width = 900;
my $table_height = $table_width/2;
my $cushion = $table_height/25;
my $pocket_radius = $cushion+5;     # it is very tricky to draw the 'jaw'.
my $rail = 0.09*$table_height;
my $rc = $rail+$cushion;
my $dr = 3;     # diamond (little circle) diameter
my $ball_radius = 10.5;     # 21 in diameter
my $co_pang = 38;
my $si_pang = 76;

my $hdr      = 17;
my $lab_ent  = 10;
my $but      = 10;
my $browse   = 10;
my $stat     = 10;
my $back     = '#99ff99';
my $sheath   = '#eeee99';
my $rail_color = 'brown';

use Tk;
use Tk::Radiobutton;
use Tk::Balloon;
use Tk::PNG;
use Tk::DirTree;
use Config::Easy 'C:\APA_Sched\config.txt';
use Date::Simple ':all';
use Net::FTP;
use File::Copy;
use File::HomeDir;
use Win32;
use Math::Trig;
use Spreadsheet::ParseExcel;
use Win32::FileOp qw/ShellExecute/;
use LWP::Simple;

$|++;       # unbuffer STDOUT

# no DOS windows, please - for system() things
Win32::SetChildShowWindow(0);

my $dir = trim($C{sched_dir});
if (!$dir) {
    $dir = File::HomeDir->my_documents();
}

chdir $dir;
open STDERR, ">", 'C:\APA_Sched\stderr.txt';

my $debug = 0;
my $dbg;
my %daynum = qw/
    Sunday    0
    Monday    1
    Tuesday   2
    Wednesday 3
    Thursday  4
    Friday    5
    Saturday  6
/;
my @full_mon_name = qw/
    none
    January
    February
    March
    April
    May
    June
    July
    August
    September
    October
    November
    December
/;
my $Gstate;
my %except;

sub empty {
    my ($s) = @_;
    return $s !~ m{\S};
}

sub trim {
    my ($s) = @_;
    $s =~ s{^\s*|\s*$}{}g;
    $s;
}

sub http_trim {
    my ($s) = @_;
    $s =~ s{\A http:// }{}msx;
    $s;
}

sub www_trim {
    my ($s) = @_;
    $s =~ s{\A www[.] }{}msx;
    $s;
}

sub trans {
    my ($s) = @_;

    $s = trim($s);
    $s =~ s{^http://}{};
    $s =~ s{^www[.]}{};
    $s =~ s{[.]com$}{};
    return $s;
}

sub slurp {
    my ($fname) = @_;

    local $/;
    open my $in, "<", $fname
        or die "cannot open $fname: $!\n";
    my $s = <$in>;
    close $in;
    return $s;
}

sub load_except {
    %except = ();
    if (open my $in, "<", 'C:\APA_Sched\except.txt') {
        EXCEPT:
        while (my $line = <$in>) {
            chomp $line;
            next EXCEPT if $line =~ m{^#} || $line !~ m{\S};
            my ($num, $rest) = $line =~ m{([^|]+)\|(.*)};
            $num = trim($num);
            $except{$num} = $rest;
        }
    }
}

my $mw = MainWindow->new(
    -title => "APA Schedule Converter",
    -background => $back,
);
my $tot_width = $table_width + $cushion*2 + $rail*2;
my $tot_height = $table_height + $cushion*2 + $rail*2;
$mw->geometry(int($tot_width) . "x" . int($tot_height));
$mw->protocol("WM_DELETE_WINDOW", sub { 
    $C{sched_dir} = $dir;
    conf_save();
    exit;
});
my $cv = $mw->Canvas(
    -background => $back,
    -width => $tot_width,
    -height => $tot_height,
)->pack(
    -anchor => 'center',
    -expand => 1,
);
# top rail
$cv->createRectangle(0, 0, $tot_width, $rail,
    -fill  => $rail_color,
    -width => 0,
);
# bottom rail
$cv->createRectangle(0, $tot_height-$rail,
                     $tot_width, $tot_height,
    -fill  => $rail_color,
    -width => 0,
);
# left rail
$cv->createRectangle(0, $rail, $rail,
                     $tot_height-$rail,
    -fill  => $rail_color,
    -width => 0,
);
# right rail
$cv->createRectangle($tot_width-$rail, $rail,
                     $tot_width, $tot_height-$rail,
    -fill  => $rail_color,
    -width => 0,
);
# pocket sheaths
$cv->createRectangle(       # top left 1
    0, 0,
    $rail+$pocket_radius, $rail,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # top left 2
    0, 0,
    $rail, $rail+$pocket_radius,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # bottom left 1
    0, $tot_height-$rail-$pocket_radius,
    $rail, $tot_height-$rail,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # bottom left 2
    0, $tot_height,
    $rail+$pocket_radius, $tot_height-$rail,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # top center
    $tot_width/2-$pocket_radius, 0,
    $tot_width/2+$pocket_radius, $rail,
    -fill => $sheath,
);
$cv->createRectangle(       # bottom center
    $tot_width/2-$pocket_radius, $tot_height-$rail,
    $tot_width/2+$pocket_radius, $tot_height,
    -fill => $sheath,
);
$cv->createRectangle(       # bottom right 1
    $tot_width-$rail-$pocket_radius, $tot_height-$rail,
    $tot_width, $tot_height,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # bottom right 2
    $tot_width-$rail, $tot_height-$pocket_radius-$rail,
    $tot_width, $tot_height-$rail,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # top right 1
    $tot_width-$rail-$pocket_radius, 0,
    $tot_width, $rail,
    -fill => $sheath,
    -width => 0,
);
$cv->createRectangle(       # top right 2
    $tot_width-$rail, $rail,
    $tot_width, $rail+$pocket_radius,
    -fill => $sheath,
    -width => 0,
);
# pockets
my @pockets = (    # (x, y) of center of circle
    $rc+$table_width/2, $rail,
    $rc+$table_width/2, $tot_height-$rail,

    $rail, $rail,
    $tot_width-$rail, $rail,
    $rail, $tot_height-$rail,
    $tot_width-$rail, $tot_height-$rail,
);
while (@pockets) {
    my $x = shift @pockets;
    my $y = shift @pockets;
    $cv->createOval(
        $x-$pocket_radius, $y-$pocket_radius,
        $x+$pocket_radius, $y+$pocket_radius,
        -fill => '#444444',
    );
}
# cushions
my $co = tan(deg2rad($co_pang));
my $si = tan(deg2rad($si_pang));
$cv->createLine(        # top left
    $rail+$pocket_radius, $rail,
    $rail+$pocket_radius+$cushion/$co, $rail+$cushion,
    $rail+$cushion+$table_width/2-$pocket_radius
        -$cushion/$si, $rail+$cushion,
    $rail+$cushion+$table_width/2-$pocket_radius, $rail,
    -width => 1,
);
$cv->createLine(        # top right
    $rail+$cushion+$table_width/2+$pocket_radius, $rail,
    $rail+$cushion+$table_width/2+$pocket_radius+$cushion/$si, $rail+$cushion,
    $tot_width-$rail-$pocket_radius-$cushion/$co, $rail+$cushion,
    $tot_width-$rail-$pocket_radius, $rail,
);
$cv->createLine(        # left
    $rail,          $rail+$pocket_radius,
    $rail+$cushion, $rail+$pocket_radius+$cushion/$co,
    $rail+$cushion, $tot_height-$rail-$pocket_radius-$cushion/$co,
    $rail,          $tot_height-$rail-$pocket_radius,
);
$cv->createLine(        # right
    $tot_width-$rail, $rail+$pocket_radius,
    $tot_width-$rail-$cushion, $rail+$pocket_radius+$cushion/$co,
    $tot_width-$rail-$cushion, $tot_height-$rail-$pocket_radius-$cushion/$co,
    $tot_width-$rail,          $tot_height-$rail-$pocket_radius,
);
$cv->createLine(        # bottom left
    $rail+$pocket_radius, $tot_height-$rail,
    $rail+$pocket_radius+$cushion/$co, $tot_height-$rail-$cushion,
    $rail+$cushion+$table_width/2-$pocket_radius-$cushion/$si,
        $tot_height-$rail-$cushion,
    $rail+$cushion+$table_width/2-$pocket_radius,
        $tot_height-$rail,
);
$cv->createLine(        # bottom right
    $rail+$cushion+$table_width/2+$pocket_radius, $tot_height-$rail,
    $rail+$cushion+$table_width/2+$pocket_radius+$cushion/$si, 
        $tot_height-$rail-$cushion,
    $tot_width-$rail-$pocket_radius-$cushion/$co, $tot_height-$rail-$cushion,
    $tot_width-$rail-$pocket_radius, $tot_height-$rail,
);
# diamonds (actually white circles)
my $r2 = 2*$rail/3;
my $rb = $tot_height-$r2;
my $rr = $tot_width-$r2;
my $t8 = $table_width/8;
my @diamonds = (        # (x, y) of center of circle
    $rc+$t8*1, $r2,
    $rc+$t8*2, $r2,
    $rc+$t8*3, $r2,
    $rc+$t8*5, $r2,
    $rc+$t8*6, $r2,
    $rc+$t8*7, $r2,

    $rc+$t8*1, $rb,
    $rc+$t8*2, $rb,
    $rc+$t8*3, $rb,
    $rc+$t8*5, $rb,
    $rc+$t8*6, $rb,
    $rc+$t8*7, $rb,

    $r2, $rc+$t8*1,
    $r2, $rc+$t8*2,
    $r2, $rc+$t8*3,

    $rr, $rc+$t8*1,
    $rr, $rc+$t8*2,
    $rr, $rc+$t8*3,
);
while (@diamonds) {
    my $x = shift @diamonds;
    my $y = shift @diamonds;
    $cv->createOval(
        $x-$dr, $y-$dr,
        $x+$dr, $y+$dr,
        -fill => 'white',
    );
}
# balls
# we need to make sure that
# no two balls occupy the same space!
#
my @nums;
my @x;
my @y;
sub place_balls {
    $cv->delete('ball');
    @x = ();
    @y = ();
    place('c');
    place('8');
    @nums = (1 .. 7, 9 .. 15);
    for (1 .. 4) {
        place(splice @nums, rand @nums, 1);
    }
}

my $rcb = $rail + $cushion + $ball_radius;
sub place {
    my ($n) = @_;
    my ($x1, $y1);
    NO_COLLISION_LOOP:
    while (1) {
        $x1 = $rcb + rand(115) + 1;
        $y1 = $rcb + rand($table_height-$ball_radius*2) - 1;
            # we need the +1 and -1 above because of the width
            # of the cushion line, I think.
        if (!@x) {
            # no other balls on the table
            last NO_COLLISION_LOOP;
        }
        for my $i (0 .. $#x) {
            if (sqrt(($x[$i] - $x1)**2 + ($y[$i] - $y1)**2)
                    <= $ball_radius*2 + 1
                        # +1 is need for some reason... ?
                        # otherwise balls can seem to overlap just
                        # a little.  perhaps int() rounding errors?
            ) {
                # the ball would overlap the
                # ball at coordinates ($x[$i], $y[$i])
                # so try again.
                next NO_COLLISION_LOOP;
            }
        }
        # the location is okay - no other balls overlap
        last NO_COLLISION_LOOP;
    }
    $cv->createImage(
        $x1, $y1,
        -image => $mw->Photo(
                      -format => 'png',
                      -file   => "C:/APA_Sched/$n.png",
                  ),
        -tags => 'ball',        # so we can easily delete it later
    );
    push @x, $x1;
    push @y, $y1;
}

place_balls();
$mw->bind('<Control-Key-r>', \&place_balls);    # for power users

my $fr = $cv->Frame(
    -background => $back,
);
$cv->createWindow(
    $tot_width/2,
    $tot_height/2,
    -window => $fr,
);

$fr->Label(
    -text => "APA Schedule Converter",
    -font => "Arial $hdr bold",
    -background => $back,
)->grid(
    -row => 0,
    -column => 0,
    -columnspan => 3,
    -ipady => 12,
);

my %widget = ();

for my $row (4 .. 8) {
    $widget{"label_$row"} = $fr->Label(
        -text => 'hello',       # whatever
        -font => "Arial $lab_ent bold",
        -width => 15,
        -foreground => $back,   # same as back
        -background => $back,
        -anchor => 'w',
    );
}

mk_entry('League Name', 'league');
show('league', 1);
mk_entry('League Website',     'league_website');
show('league_website', 2);
mk_entry('Schedule Directory', 'sched_dir');
show('sched_dir', 3);

my $hosting = $C{hosting};
$fr->Label(
    -text => "Hosting",
    -font => "Arial $lab_ent bold",
    -width => 15,
    -background => $back,
    -anchor => 'w',
)->grid(
    -row => 4,
    -column => 0,
    -sticky => 'e',
    -ipady => 5,
    -pady => 3,
    -padx => 5,
);
my $fr_radio = $fr->Frame(
    -background => $back,
)->grid(
    -row => 4,
    -column => 1,
);
my $manual_radio = $fr_radio->Radiobutton(
    -variable => \$hosting,
    -value => 'manual',
    -text => "Manual",
    -font => "Arial $lab_ent bold",
    -background => $back,
    -activebackground => $back,
    -command => sub {
        $C{hosting} = 'manual';
        hide('ftp_site',  5);
        hide('ftp_user',  6);
        hide('ftp_pass',  7);
        hide('ftp_dir',   8);
        hide('host_pass', 5);
    },
)->grid(
    -row => 0,
    -column => 0,
    -ipadx => 10,
);
my $ftp_radio = $fr_radio->Radiobutton(
    -variable => \$hosting,
    -value => 'ftp',
    -text => 'FTP',
    -font => "Arial $lab_ent bold",
    -background => $back,
    -activebackground => $back,
    -command => sub {
        $C{hosting} = 'ftp';
        show('ftp_site',  5);
        show('ftp_user',  6);
        show('ftp_pass',  7);
        show('ftp_dir',   8);
        hide('host_pass', 5);
        $widget{entry_ftp_user}->focus();
    },
)->grid(
    -row => 0,
    -column => 1,
    -ipadx => 10,
);
my $external_radio = $fr_radio->Radiobutton(
    -variable => \$hosting,
    -value => 'external',
    -text => "External",
    -font => "Arial $lab_ent bold",
    -background => $back,
    -activebackground => $back,
    -command => sub {
        $C{hosting} = 'external';
        hide('ftp_site',  5);
        hide('ftp_user',  6);
        hide('ftp_pass',  7);
        hide('ftp_dir',   8);
        show('host_pass', 5);
        $widget{entry_host_pass}->focus();
    },
)->grid(
    -row => 0,
    -column => 2,
    -ipadx => 10,
);

mk_entry('FTP Site',           'ftp_site');
mk_entry('FTP User',           'ftp_user');
mk_entry('FTP Password',       'ftp_pass');
mk_entry('FTP Directory',      'ftp_dir');
mk_entry('Hosting Password',   'host_pass');

if ($hosting eq 'ftp') {
    show('ftp_site', 5);
    show('ftp_user', 6);
    show('ftp_pass', 7);
    show('ftp_dir',  8);
}
elsif ($hosting eq 'external') {
    hide('ftp_site',  5);
    hide('ftp_user',  6);
    hide('ftp_pass',  7);
    hide('ftp_dir',   8);
    show('host_pass', 5);
}
elsif ($hosting eq 'manual') {
    hide('ftp_site', 5);
    hide('ftp_user', 6);
    hide('ftp_pass', 7);
    hide('ftp_dir',  8);
}

my $browsing = 0;

sub mk_entry {
    my ($lab, $key) = @_;

    $widget{"label_$key"} = $fr->Label(
        -text => $lab,
        -font => "Arial $lab_ent bold",
        -width => 15,
        -background => $back,
        -anchor => 'w',
    );
    my @opt = ();
    if ($key =~ m{pass}) {
        @opt = (-show => '*');
    }
    $widget{"entry_$key"} = $fr->Entry(
        -textvariable => ($key eq 'sched_dir'? \$dir: \$C{$key}),
        -font => "Arial $lab_ent normal",
        -width => 40,
        @opt,
    );
    if ($lab eq 'Schedule Directory') {
        $widget{browse} = $fr->Button(
            -text => 'Browse',
            -font => "Arial $browse bold",
            -background => '#ddffdd',
            -activebackground => '#55ff55',
            -command => sub {
                return if $browsing;
                my $mw1 = MainWindow->new(
                    -title => "Browsing for Schedule Directory",
                );
                $mw1->protocol("WM_DELETE_WINDOW", sub { 
                    $mw1->destroy();
                    $browsing = 0;
                });
                $mw1->Label(
                    -font => "Arial $browse bold",
                    -text => "Double click to select a directory.",
                    -bg => $back,
                    -height => 1,
                )->pack(-expand => 1, -fill => 'x');
                my $dirtree;
                $dirtree = $mw1->Scrolled('DirTree',
                    -scrollbars => 'osoe',
                    -directory => $dir,
                    -bg => $back,
                    -selectbackground => 'white',
                    -font => "Arial $browse",
                    -height => 30,
                    -width => 40,
                    -command => sub {
                        my @files = $dirtree->selectionGet();
                        $dir = $files[0];
                        $mw1->destroy();
                        $browsing = 0;
                        chdir $dir;
                    },
                )->pack(-expand => 1, -fill => 'both');
                $browsing = 1;
            },
        )->grid(
            -row => 3,
            -column => 2,
            -sticky => 'w',
            -padx => 7,
        );;
    }
}

sub show {
    my ($key, $row) = @_;

    $widget{"label_$key"}->grid(
        -row => $row,
        -column => 0,
        -sticky => 'e',
        -ipady => 5,
        -pady => 3,
        -padx => 5,
    );
    $widget{"entry_$key"}->grid(
        -row => $row,
        -column => 1,
        -columnspan => 1,
        -sticky => 'w',
    );
}
sub hide {
    my ($key, $row) = @_;

    $widget{"label_$key"}->gridForget();
    $widget{"entry_$key"}->gridForget();

    # to ensure the same row height we grid an invisible label
    $widget{"label_$row"}->grid(
        -row => $row,
        -column => 0,
        -columnspan => 2,
        -sticky => 'e',
        -ipady => 5,
        -pady => 3,
        -padx => 5,
    );
}

$widget{entry_league}->focus();

my $status = "";

# spacer
my $status_lab = $fr->Label(
    -textvariable => \$status,
    -background => $back,
    -font => "Arial $stat bold",
    -fg => 'black',
)->grid(
    -row => 9,
    -column => 0,
    -columnspan => 3,
    -ipady => 10,
);

my $ext_msg = "";
my $balloon = $mw->Balloon(
    -statusbar => $status_lab,
    -initwait  => 0,
    -postcommand => sub {
        $ext_msg = "The schedules will be published to"
                   . " http://www.logicalpoetry.com/"
                   . trans($C{league_website})
                   ;
        $status_lab->configure(-fg => 'black');
        return 1;
    },
);
$balloon->attach(
    $manual_radio,
    -statusmsg => "You will publish the schedules yourself.",
);
$balloon->attach(
    $ftp_radio,
    -statusmsg => "The schedules will be FTP'ed to your league site.",
);
$balloon->attach(
    $external_radio,
    -statusmsg => \$ext_msg,
);

my $fr1 = $fr->Frame(
    -background => $back,
)->grid(
    -row => 10,
    -column => 0,
    -columnspan => 4,
    -sticky => 'we',
);

$fr1->Button(
    -text => "Convert",
    -font => "Arial $but bold",
    -background => '#ddffdd',
    -activebackground => '#55ff55',
    -width => 10,
    -command => sub {
        convert_all();
    },
)->grid(
    -row => 0,
    -column => 0,
    -padx => 5,
);

$fr1->Button(
    -text => "View",
    -font => "Arial $but bold",
    -background => '#ddffdd',
    -activebackground => '#55ff55',
    -width => 10,
    -command => sub {
        if (! -f "index.html") {
            return my_die("Nothing to view.");
        }
        ShellExecute("index.html");
    },
)->grid(
    -row => 0,
    -column => 1,
    -padx => 5,
);

$fr1->Button(
    -text => "Publish",
    -font => "Arial $but bold",
    -background => '#ddffdd',
    -activebackground => '#55ff55',
    -width => 10,
    -command => sub {
        if ($C{hosting} eq 'manual') {
            return my_die("You chose to manually publish the files yourself.");
        }
        elsif ($C{hosting} eq 'external') {
            if (! -f "index.html") {
                return my_die("Nothing to publish.");
            }
            if (! -f "style.css") {
                return
                    my_die("Since you changed the hosting option since"
                     ." you last converted, please do the conversion again.");
            }
            if (empty($C{host_pass})) {
                return my_die("You must supply the logicalpoetry.com"
                              . " hosting password.");
            }
            # verify the league website name and the hosting password
            # by asking logicalpoetry.com/cgi-bin/verify
            #
            if (get("http://www.logicalpoetry.com/cgi-bin/verify?"
                    . "league_website=$C{league_website}"
                    . "&password=$C{host_pass}")
                 ne 'okay'
            ) {
                return my_die("Invalid hosting password");
            }
        }
        elsif ($C{hosting} eq 'ftp') {
            if (! -f "index.html") {
                return my_die("Nothing to publish.");
            }
            if (! -f "style.css") {
                return my_die("Please do the conversion again first"
                             ." and then choose Publish.");
            }
            if (   empty($C{ftp_site})
                || empty($C{ftp_user})
                || empty($C{ftp_pass})
                || empty($C{ftp_dir})
            ) {
                return my_die("You must supply complete FTP information.");
            }
        }
        $status_lab->configure(-fg => 'black');
        $status = "Connecting to "
                  . ($C{hosting} eq 'ftp'? $C{ftp_site}
                    :                      "logicalpoetry.com")
                  . " ..."
                  ;
        $mw->after(10, \&publish);
    },
)->grid(
    -row => 0,
    -column => 2,
    -padx => 5,
);

$fr1->Button(
    -text => "Quit",
    -font => "Arial $but bold",
    -background => '#ddffdd',
    -activebackground => '#55ff55',
    -width => 10,
    -command => sub {
        $C{sched_dir} = $dir;
        conf_save();
        exit;
    },
)->grid(
    -row => 0,
    -column => 3,
    -padx => 5,
);

MainLoop();

my %game_tally;
my %div_name;
my %day_of_play;
my %div_team;
my %div_timestamp;
my $nscheds;
my @scheds;
my $cur_sched;
my $errs;
my $cur_timestamp;
my ($style, $javascript);

sub convert_all {
    if ($C{hosting} eq 'manual') {
        $style = "<style type='text/css'>\n"
                 . slurp('C:\APA_Sched\style.css')
                 . "</style>\n"
                 ;
        $javascript = "<script type='text/javascript'>\n"
                      . slurp('C:\APA_Sched\init.js')
                      . "</script>\n"
                      ;
    }
    else {
        $style = "<link rel='stylesheet' type='text/css' href='style.css' />";
        $javascript = "<script src='init.js'></script>";
    }
    if (empty($C{league})) {
        return my_die("Please supply a League Name.");
    }
    if (empty($C{league_website})) {
        return my_die("Please supply a League Website.");
    }
    # JUST in case they changed the system time
    # after they started APA_Sched...
    #
    $cur_timestamp = scalar(localtime);
    $cur_timestamp =~ s{^... (... ..).*}{$1};
    $cur_timestamp = "<span class=timestamp>Last updated on $cur_timestamp</span>";
    
    $status_lab->configure(-fg => 'black');
    %game_tally = %div_name = %div_team = %div_timestamp = ();
    load_except();
    $C{sched_dir} = $dir;
    chdir $C{sched_dir};        # in case it changed ...
    $debug = $C{league} =~ m{xx$};
    if ($debug) {
        $dbg = undef;
        open $dbg, ">", "debug.txt";
    }
    # clear the scene before converting again
    #
    unlink <*.html *.css *.js *.txt>;
    if ($C{hosting} ne 'manual') {
        copy 'C:\APA_Sched\style.css', 'style.css';
        copy 'C:\APA_Sched\init.js',   'init.js';
    }
    @scheds = sort <*.pdf *.xls>;
    $nscheds = scalar(@scheds);
    $cur_sched = 1;
    if ($nscheds == 0) {
        $status = "No schedules found in $dir.";
        return;
    }
    $status = "Converting $cur_sched of $nscheds ...";
    $mw->after(300, \&next_sched);
}

sub next_sched {
    if ($cur_sched <= $nscheds) {
        convert_sched($scheds[$cur_sched-1]);
        if ($errs) {
            $status_lab->configure(-fg => 'red');
            return;     # stop on first error
        }
        ++$cur_sched;
        if ($cur_sched <= $nscheds) {
            $status = "Converting $cur_sched of $nscheds ...";
            $mw->after(300, \&next_sched);
            return;
        }
    }
    generate();
}

sub generate {
    open my $out, ">", "index.html"
        or die "no index.html: $!\n";
    print {$out} <<"EOH";
<html>
<head>
$style
</head>
<body>
<h1><a style="text-decoration: none; color: black;" href="http://$C{league_website}">$C{league}</a></h1>
<p class=instr>
See your team's schedule by first clicking on your division
and then on your team.<br>
On that page you can request a weekly
email reminder of where your team is playing.
</p>
<table cellpadding=4 border=1>
<tr>
<th>&nbsp;Day of Play</th>
<th width=200 align=left>&nbsp;Division Name</th>
<th width=30 align=right>#&nbsp;</th>
</tr>
EOH
    for my $d (sort by_day keys %div_name) {
        my $d0 = sprintf("%03d", $d);
        print {$out} <<"EOH";
<tr>
<td align=left>&nbsp;$day_of_play{$d}</a></td>
<td>&nbsp;<a href=#$d>$div_name{$d}</a></td>
<td align=right>$d0&nbsp;</td>
</tr>
EOH
    }
    print {$out} "</table>\n";

    #
    # Host Site Match Tallies
    #
    print {$out} <<"EOH";
<p class=instr>
How many matches does each host site need to provide for?
</p>
<table cellpadding=5 border=1>
<tr>
<th>&nbsp;Host Site</th>
</tr>
EOH

    for my $hn (sort keys %game_tally) {
        my $fname = host_fname($hn);
        print {$out} "<tr><td>&nbsp;<a href=$fname>$hn</a></td></tr>\n";
    }
    print {$out} "</table>\n";

    for my $d (sort by_day keys %div_team) {
        my $d0 = sprintf("%03d", $d);
        print {$out} <<"EOH";
<a name=$d>
<table style="margin-top: 9mm; margin-bottom: 2mm;">
<tr><td align=right class=divhead>Division $d0:</td><td align=left class=divhead>$div_name{$d}$div_timestamp{$d}</td></tr>
<tr><td align=right class=divhead>Day of Play:</td><td align=left class=divhead>$day_of_play{$d}</td></tr>
</table>
<table cellpadding=4 border=1>
<tr><th width=30 align=right>#&nbsp;</th><th width=250 align=left>&nbsp;Team Name</th></tr>
EOH
        for my $n (sort {$a <=> $b} keys %{$div_team{$d}}) {
            print {$out} "<tr><td align=right>$n&nbsp;</td><td>&nbsp;<a href=$d-$n.html>$div_team{$d}{$n}</td></tr>\n";
        }
        print {$out} "</table>\n";
    }
    print {$out} <<"EOH";
</body>
</html>
EOH
    close $out;
    #
    # host table tallies
    #
    for my $host (sort keys %game_tally) {
        my $fn = host_fname($host);
        open my $tt, ">", $fn
            or die "cannot create $fn: $!\n";
        print {$tt} <<"EOH";
<html>
<head>
$style
</head>
<body>
EOH
        print {$tt} <<"EOH";
<p class=hostname>$host$cur_timestamp</p>
EOH
        my %months = ();
        for my $dt (keys %{$game_tally{$host}}) {
            $months{substr($dt, 0, 6)} = 1;
        }
        for my $mon (sort keys %months) {
            my $y = substr($mon, 0, 4);
            my $m = substr($mon, 4, 2);
            my $mdays = days_in_month($y, $m);
            my $dow = date($y, $m, 1)->day_of_week();
            print {$tt} <<"EOH";
<table cellpadding=5 border=1>
<tr>
<td colspan=7 class=monthname>$full_mon_name[$m]</td>
</tr>
<tr>
<td class=dayname>Sun</td>
<td class=dayname>Mon</td>
<td class=dayname>Tue</td>
<td class=dayname>Wed</td>
<td class=dayname>Thu</td>
<td class=dayname>Fri</td>
<td class=dayname>Sat</td>
</tr>
EOH
            # days before the first
            for (0 .. $dow-1) {
                print {$tt} "<td class=day>&nbsp;</td>\n";
            }
            for my $d (1 .. $mdays) {
                my $dt = "$y$m" . sprintf("%02d", $d);
                my $n = (exists $game_tally{$host}{$dt})?
                               $game_tally{$host}{$dt}/2: '&nbsp;';
                print {$tt} <<"EOF";
<td class=day>
<div class=daynum>$d</div>
<div class=tally>$n</div>
</td>
EOF
                ++$dow;
                if ($dow == 7) {
                    $dow = 0;
                    print {$tt} "</tr>\n<tr>\n";
                }
            }
            # days after the last day
            for ($dow .. 6) {
                print {$tt} "<td class=day>&nbsp;</td>\n";
            }
            print {$tt} "</tr>\n";
            print {$tt} "</table><p>\n";
        }
        close $tt;
    }
    my $pl = $nscheds == 1? "": "s";
    $status = "$nscheds schedule$pl converted.";
    #
    # mark this operator and site as having
    # used the converter (and likely having published).
    # I put this here instead of after sub publish()
    # in case they are publishing the files themselves (unlikely).
    #
    my $pub_txt = 'C:/APA_Sched/published.txt';
    if (! -f $pub_txt) {
        get("http://www.logicalpoetry.com/cgi-bin/published?league_website="
            . www_trim(http_trim($C{league_website})));
        open my $out, '>', $pub_txt;
        close $out;
    }
}

sub host_fname {
    my ($hn) = @_;
    $hn = lc $hn;
    $hn =~ s{ }{_}g;
    $hn =~ s{[^\w]}{}g;
    "$hn.html";
}

my @bye_teams;
sub is_bye {
    my ($team) = @_;
    for my $b (@bye_teams) {
        if ($b == $team) {
            return 1;
        }
    }
    return 0;
}

sub convert_sched {
    my ($fname) = @_;

    print {$dbg} "$fname\n" if $debug;
    my ($delim, $delim_char);
    if ($fname =~ m{[.]pdf}i) {
        system(qq!C:/APA_Sched/pdftotext.exe -layout "$fname"!);
        $delim = '\s\s+';
        $delim_char = " ";
    }
    else {
        my $outfile = $fname;
        $outfile =~ s{xls$}{txt}i;

        my $parser   = Spreadsheet::ParseExcel->new();
        my $workbook = $parser->parse($fname);
        if ( !defined $workbook ) {
            die $parser->error(), ".\n";
        }

        open my $out, ">", $outfile
            or die "cannot open $outfile: $!\n"; 

        for my $worksheet ($workbook->worksheets()) {

            my ( $row_min, $row_max ) = $worksheet->row_range();
            my ( $col_min, $col_max ) = $worksheet->col_range();

            for my $row ($row_min .. $row_max) {
                for my $col ($col_min .. $col_max) {

                    my $cell = $worksheet->get_cell( $row, $col );
                    next unless $cell;

                    print {$out} $cell->value();
                    if ($col != $col_max) {
                        print {$out} "~";
                    }
                }
                print {$out} "\n";
            }
        }
        close $out;
        $delim = qr{~[~\s]*};     # ~ followed by one or more ~ or spaces 
        $delim_char = "~ ";
    }
    my $txt = $fname;
    $txt =~ s{(pdf|xls)$}{txt}i;

    open my $in, "<", $txt
        or die "no $txt: $!\n";

    my %matches;
    @bye_teams = ();
    my @team;
    my %host;
    my $div;
    my $div0;
    my $division = "";
    my $day_of_play;

    $errs = 0;
    LINE:
    while (my $line = <$in>) {
        print {$dbg} "line: $line" if $debug;
        chomp $line;
        $line =~ s{[.]00}{};        # hack for weird spreadsheet error
        if ($line =~ m{Printed \s* (\d+)/(\d+)/(\d+) }xms) {
            print {$dbg} "date updated: $line\n" if $debug;
            print {$dbg} "date $1 $2, $3\n"      if $debug;
            my ($month, $day) = ($1, $2);       # as of date
            $month = substr($full_mon_name[$month], 0, 3);
            if ($div) {
                $div_timestamp{$div}
                    = "<span class=timestamp>Last updated on $month $day</span>";
            }
            next LINE;
        }
        if ($line =~ m{Division Rep}i) {
            print {$dbg} "ignore div rep: $line" if $debug;
            next LINE;
        }
        if ($line =~ m{day of play}i) {
            ($day_of_play) = $line =~ m{(\w+)\s*$};
            print {$dbg} "day of play: $line - got $day_of_play\n" if $debug;
            # need to remember this until we find
            # the division number.
        }
        if (! $div && $line =~ m{ \A \s* (\d+) }xms) {
            print {$dbg} "got division? $line" if $debug;
            if ($div && $division) {
                $status = "$fname: Cannot have more than one division in a file.";
                ++$errs;
                return;
            }
            # division and name
            #
            $div = $1;
            $div =~ s{^0}{};
            $div0 = sprintf("%03d", $div);
            $division = $line;
            $division =~ s{ \A \s* \d+ [\s-]*  }{}xms;
            $division =~ s{ \s* \z }{}xms;
            print {$dbg} "got div $div and division '$division'\n"
                if $debug;
            $div_name{$div} = $division;
            $day_of_play{$div} = $day_of_play;
        }
        elsif ($line =~ m{^\s*\d+$delim\d+/\d+/\d+}) {
            print {$dbg} "home-away: $line\n" if $debug;
            # a date, home-away line
            #
            next LINE unless $line =~ m{^[\d\s\-/$delim_char]*$};
                # the line was to indicate a special week
                # like Play Off or No Play, etc.
                # skip it.
            $line =~ s{^\s*}{};

            my @flds = split m{$delim}, $line;
            my $week = shift @flds;    # week #
            my $date = shift @flds;
            my $date_obj = Date::Simple->new($date);
            my $d = $date_obj->as_d8();

            # the rest of the fields are in this format: 4-6
            for my $f (@flds) {
                my ($home, $away) = split m{-}, $f;
                print {$dbg} "got $home, $away\n" if $debug;
                if (! ($home =~ m{^\d+$} && $away =~ m{^\d+$})) {
                    my $mon = $date_obj->month();
                    my $day = $date_obj->day();
                    my $date = substr($full_mon_name[$mon], 0, 3) . " $day";
                    $status = "$fname: bogus home-away:"
                              . " $home-$away on week $date";
                    ++$errs;
                    return;
                }
                $f = [ $home, $away ];
            }

            $matches{$d} = \@flds;
        }
        elsif (defined $div && $line =~ m{^\s*0?$div}) {
            print {$dbg} "host: $line\n" if $debug;
            # team home etc
            #
            # get team number first
            $line =~ s{^\s*(\d+)$delim}{};
            my $num = $1;
            my ($name, $home, $addr, $city, $state, $phone);
            my $dl = $delim;
            if ($except{$num}) {
                $line = $except{$num};
                print {$dbg} "using except: $line\n" if $debug;
                $dl = qr{\s*\|\s*};
            }
            ($name, $home, $addr, $city, $state, $phone)
                = split $dl, $line; 
            #
            # did we get the data properly?
            #
            if (! (defined $state && length($state) == 2)
                && length($city) == 2
                && $home =~ m{\d}
            ) {
                # likely what happened was that
                # the $home site name and $addr address
                # were merged into $home because there were
                # not two spaces between them.
                # Split them apart at the first digit.
                # the others 'ripple down'.
                #
                $phone = $state;
                $state = $city;
                $city = $addr;
                my ($h, $a) = $home =~ m{(\D+)(\d.*)};
                $addr = $a;
                $home = $h;
            }
            elsif ($state =~ m{^[\d-]+$}) {
                # they forgot the state?
                # and the phone became the state
                $phone = $state;
                $state = '';
            }
            elsif ($name !~ m{bye}i
                   && empty($addr) && empty($state) && empty($phone)
            ) {
                # it is all screwed up - error!
                $status = "$fname: host address error for team named '$name'.";
                ++$errs;
                return;
            }
            if (!$Gstate) {
                $Gstate = $state;
            }
            for my $f ($name, $home, $addr, $city, $state, $phone) {
                if (!$f) {
                    $f = "&nbsp;";
                }
            }
            $num =~ s{.*(\d\d)$}{$1};
            $num =~ s{^0*}{};
            if ($name =~ m{^bye$}i) {
                push @bye_teams, $num;
                $team[$num] = {
                    name => "Bye",
                    home => "",
                };
            }
            else {
                $team[$num] = {
                    name => $name,
                    home => $home,
                };
                $div_team{$div}{$num} = $name;
                # shoreline had a troublesome two part address :(
                #if ($home =~ m{shoreline}i) {
                #    $city = "Mountain View";
                #    $phone = "650-964-0780";
                #}
                if (! exists $host{$home}) {
                    $host{$home} = {
                        addr => $addr,
                        city => $city,
                        state => $state,
                        phone => $phone,
                    };
                }
            }
        }
        else {
            print {$dbg} "ignore: $line\n" if $debug;
            # ignore the line
        }
    }
    close $in;
    unlink $txt if ! $debug;
    if ($errs) {
        return;
    }

    $errs = 0;      # start again
    # schedules for each team:
    TEAM:
    for my $i (1 .. $#team) {
        if ($team[$i]{name} eq 'Bye') {
            next TEAM;
        }

        open my $out, ">", "$div-$i.html"
            or die "cannot open $div-$i.html: $!\n";
        print {$out} <<"EOH";
<html>
<head>
$style
<script type="text/javascript">
var dates = new Array(1
EOH
        my @dates = sort keys %matches;
        for my $d (@dates) {
            print {$out} ",$d\n";
        }
        my $trim_site = http_trim($C{league_website});
        my $site_html = get("http://$trim_site");
        if (! $site_html && $hosting eq 'external') {
            # for some reason the league website is not
            # accessible.  link instead to the top page
            # that we published externally.
            #
            $trim_site = "www.logicalpoetry.com/"
                       . trans($C{league_website})
                       ;
        }
        print {$out} <<"EOH";
);
</script>
$javascript
</head>
<body onload="init();">
<!-- state $Gstate -->
<h1>Team $i: $team[$i]{name}$div_timestamp{$div}</h1>
<p>
<table cellpadding=5 style="margin-bottom: 2mm;">
<tr><td class=header align=right>Day of Play:</td><td class=header>$day_of_play
<span id=email_reminder style="margin-left: 1in; font-size: 13pt;"></span>
</td></tr>
<tr><td class=header align=right>Division $div0:</td><td class=header>$division</td></tr>
<tr><td class=header align=right>League:</td><td class=header><a href="http://$trim_site">$C{league}</a></td></tr>
</table>
<table cellpadding=5 border=1>
<tr>
<th>&nbsp;Date</th>
<th>&nbsp;Host Site</th>
<th>&nbsp;Opponent</th>
</tr>
EOH
        my $reminder_data = "";
        my $r = 1;
        for my $d (@dates) {
            my ($host, $against);
            MATCH:
            for my $m (@{$matches{$d}}) {
                my ($home, $away) = @$m;
                if ($home == $i || $away == $i) {
                    $host = $home;
                    $against = ($home == $i)? $away
                               :              $home
                               ;
                    last MATCH;
                }
            }
            my $mon = substr($d, 4, 2);
            my $day = int(substr($d, 6, 2));    # remove any leading zero 
            my $date = substr($full_mon_name[$mon], 0, 3) . " $day";
            print {$out}
                  "<tr id=r$r><td>&nbsp;"
                  . $date
                  . "</td>"
                  ;
            ++$r;
            if (! $host     # couldn't find it on the line so must be a bye?
                ||
                (is_bye($host) || is_bye($against))
            ) {
                print {$out} "<td colspan=2 align=center>Bye</td>";
                $reminder_data .= "$d|Bye|\n";
            }
            else {
                if (! exists $team[$host]{home}) {
                    $host = $i;     # recover from an error somehow
                                    # Doug says a team dropped out.
                                    # Not sure what happens if team
                                    # numbers are altered too much.
                                    # I guess a full republish is needed.
                                    # This fix is bogus but the dates
                                    # should be in the past so no one
                                    # may even notice, right?
                }
                if (! exists $team[$against]{name}) {
                    $against = $i;
                }
                ++$game_tally{$team[$host]{home}}{$d};
                print {$out} "<td>&nbsp;$team[$host]{home}</td>"
                           . "<td>&nbsp;$team[$against]{name}</td>";
                $reminder_data 
                    .= "$d|$team[$host]{home}|$team[$against]{name}\n";
            }
            print {$out} "</tr>\n";
        }
        print {$out} "</table>\n";

        # host info
        print {$out} <<"EOH";
<h2>Host Sites<span class=mapclick>Click on the address for a map.</span></h2>
<table cellpadding=5 border=1>
<tr>
<th>Name</th>
<th>Address</th>
<th>City</th>
<th>Telephone</th>
</tr>
EOH
        for my $h (sort keys %host) {
            my $addr = $host{$h}{addr};
            $addr =~ s{# C-1}{};     # special case
            print {$out}
                  "<tr>"
                . "<td>$h</td>"
                . "<td><a target=_blank href='http://maps.google.com/maps?near="
                  . "$addr $host{$h}{city} $host{$h}{state}"
                  . "'>$host{$h}{addr}</a></td>"
                . "<td>$host{$h}{city}</td>"
                . "<td>$host{$h}{phone}</td>"
                . "</tr>"
                . "\n";
        }
        print {$out} "</table>\n";
        #
        # cleanly formatted data for reminders
        #
        print {$out} "<!--REMINDER\n${reminder_data}REMINDER-->\n";
        print {$out} "</body>\n</html>\n";
        close $out;
    }
}

my $curf;
my $nfiles;
my @files;
my $ftp;

sub publish {
    my ($ftp_site, $ftp_user, $ftp_pass, $ftp_dir);
    if ($C{hosting} eq 'ftp') {
        $ftp_site = trim($C{ftp_site});
        $ftp_user = trim($C{ftp_user});
        $ftp_pass = trim($C{ftp_pass});
        $ftp_dir  = trim($C{ftp_dir});
    }
    else {
        # external => publish to logicalpoetry.com
        #
        # won't get here - this is from when
        # it was hosted at apasched.com - now defunct
        # If we want to rejuventate this we'll need
        # to supply a new 'encrypted' password.
        $ftp_site = "logicalpoetry.com";
        $ftp_user = gzz2A("xznopsn~l{l");   # don't mess with this
        $ftp_pass = gzz2A(",zwWps");        # or this
        $ftp_dir  = "htdocs/" . trans($C{league_website});
    }
    $ftp = Net::FTP->new($ftp_site, Timeout => 5)
        or return my_die("Cannot connect to $ftp_site");
    $ftp->login($ftp_user, $ftp_pass)
        or return my_die("Cannot login - check user and password.");

    my @comps = split m{[/\\]}, $ftp_dir;
    my $dir = "";
    while (my $c = shift @comps) {
        $ftp->mkdir($c);
        $dir .= "$c/";
        $ftp->cwd($c) or return my_die("Cannot change to directory $dir.");
    }

    $ftp->ascii();
    @files = <*.html>;
    if ($C{hosting} ne 'manual') {
        push @files, <*.css *.js>;
    }
    $nfiles = @files;
    $curf = 0;
    $status = sprintf "Publishing file %d of $nfiles ...", $curf+1;
    $mw->after(10, \&put_next);
}

sub put_next {
    if ($curf < $nfiles) {
        $ftp->put($files[$curf])
                or return my_die("Could not publish $files[$curf]");
        $status = sprintf "Publishing file %d of $nfiles ...", $curf+1;
        ++$curf;
        $mw->after(10, \&put_next);
    }
    else {
        $status = "$nfiles files published to "
                  . ($C{hosting} eq 'ftp'? $C{league_website}
                                           . '/' . $C{ftp_dir}
                     :                     "www.logicalpoetry.com/"
                                           . trans($C{league_website}));
        $ftp->quit();
    }
}

sub my_die {
    $status = shift;
    $status_lab->configure(-fg => 'red');
}

sub by_day {
    $daynum{$day_of_play{$a}} cmp $daynum{$day_of_play{$b}} or
    $div_name{$a} cmp $div_name{$b}
}

sub gzz2A { my ($s) = @_; my $t = ""; my $l = length($s); for (my $i = $l-1; $i >= 0; --$i) { $t .= chr(ord(substr($s, $i, 1))-(4*2+3)); } $t; }
